Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue54/Persist/tiPtnVisitor.pas

Pascal/Delphi Source File | 2000-01-23 | 9.2 KB | 317 lines

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  (c) TechInsite Pty. Ltd.
  PO Box 429, Abbotsford, Melbourne. 3067 Australia
  Phone: [phone]
  Fax:   [phone]
  Web:   www.techinsite.com.au
  EMail: [e-mail]

  Created: Jan 2000

  Notes: Family of abstract classes to provide functionality of the
         Vistior Pattern

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit tiPtnVisitor;

interface
uses
  Classes
  ;

type

  // TVisitedAbs forward declaration
  TVisitedAbs = class ;

  // TVisitorAbs: The class that does the visiting
  //----------------------------------------------------------------------------
  TVisitorAbs = class( TObject )
  private
    FVisited   : TVisitedAbs ;
  protected
    function    AcceptVisitor : boolean ; virtual ;
  public
    constructor create ; virtual ;
    procedure   execute( pVisited : TVisitedAbs ) ; virtual ;

    property    Visited   : TVisitedAbs read FVisited write FVisited ;

  end ;

  // TVisitorClass reference
  //----------------------------------------------------------------------------
  TVisitorClass = class of TVisitorAbs ;

  // TVisitedAbs
  // Descends from TTransportAbstract, for streaming...
  // The class that gets visited.
  //----------------------------------------------------------------------------
  TVisitedAbs = class( TPersistent )
  private
    FbSelfIterate: boolean;
  protected
    function    GetCaption : string ; virtual ;
  published
  public
    constructor create ; virtual ;
    procedure   Iterate( pVisitor : TVisitorAbs ) ; virtual ;
    property    SelfIterate : boolean read FbSelfIterate write FbSelfIterate ;
    property    Caption     : string  read GetCaption ;
  end ;

  // A wrapper for the TList which allows its elements to be visited
  //----------------------------------------------------------------------------
  TVisList = class( TVisitedAbs )
  private
    FList   : TList ;
    FsName: string;

    function    GetCount: integer;
    function    GetItems(i:integer): TObject;
    procedure   SetItems(i: integer; const Value: TObject);

  protected
    function    GetCaption : string ; override ;
  public
    constructor create ; override;
    constructor CreateExt( const psName : string ) ;
    destructor  destroy ; override ;

    procedure   Iterate( pVisitor : TVisitorAbs ) ; override ;
    property    Count : integer read GetCount ;
    property    Items[i:integer] : TObject read GetItems write SetItems ;
    procedure   Delete( i : integer ) ;
    procedure   Add( pObject : TObject ) ;
    procedure   Clear ;
    property    List : TList read FList ;
    property    Name : string read FsName write FsName ;
    function    IndexOf( pData : TObject ) : integer ;
    function    LastItem : TObject ; virtual ;
  end ;

  // A wrapper for the TStream which allows text to be written to the stream
  // with each visit.
  //----------------------------------------------------------------------------
  TVisStream = class( TVisitorAbs )
  private
    FStream : TStream ;
  protected
    procedure Write( const psValue : string ) ;
    procedure WriteLn( const psValue : string ) ;
  public
    property  Stream : TStream read FStream write FStream ;
  end ;

  TVisStreamClass = class of TVisStream ;

implementation
uses
   SysUtils  // Exception
  ,tiUtils   // GetPropNames
  ,TypInfo   // GetObjectProp
  ;

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// *
// * TVisitedAbs
// *
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
constructor TVisitedAbs.create;
begin
  inherited create ;
end;

//------------------------------------------------------------------------------
function TVisitedAbs.GetCaption: string;
begin
  result := className ;
end;

//------------------------------------------------------------------------------
procedure TVisitedAbs.Iterate(pVisitor: TVisitorAbs) ;
var
  lsl      : TStringList ;
  i        : integer ;
  j        : integer ;
  lVisited : TObject ;
begin
  Assert( pVisitor <> nil, 'Visitor unassigned' ) ;
  try
    pVisitor.Execute( self ) ;

    // If SelfIterate is true, then use RTTI to scan through all the
    // properties of type TVisitedAbs
      // Create a string list to hold the property names
      lsl := TStringList.Create ;
      try
        // Get all property names of type tkClass
        tiGetPropertyNames( self, lsl, [tkClass] ) ;
        // Scan through these properties
        for i := 0 to lsl.Count - 1 do begin
          // Get a pointer to the property

          lVisited := GetObjectProp( self, lsl.Strings[i] ) ;

          // If the property is a TVisitedAbs, then visit it.
          if ( lVisited is TVisitedAbs ) then
            TVisitedAbs( lVisited ).Iterate( pVisitor ) ;

          // If the property is a TList, then visit it's items
          if (lVisited is TList ) then
            for j := 0 to TList( lVisited ).Count - 1 do
              if ( TObject( TList( lVisited ).Items[j] ) is TVisitedAbs ) then
                TVisitedAbs( TList( lVisited ).Items[j] ).Iterate( pVisitor ) ;

        end ;
      finally
        lsl.Free ;
      end ;

  except
    on e:exception do
      raise exception.Create( 'Error processing visitor: ' + pVisitor.ClassName + #13 +
                              'Called in ' + ClassName + '.Iterate.' + #13 +
                              'Message: ' + e.message ) ;
  end ;

end ;

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// *
// * TVisitorAbs
// *
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
function TVisitorAbs.AcceptVisitor : boolean;
begin
  result := true ;
end;

//------------------------------------------------------------------------------
constructor TVisitorAbs.create;
begin
  inherited create ;
end;

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// *
// * TVisList
// *
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
procedure TVisList.Add(pObject: TObject);
begin
  FList.Add( pObject ) ;
end;

//------------------------------------------------------------------------------
procedure TVisList.Clear;
var
  i : integer ;
begin
  for i := FList.Count - 1 downto 0 do
    if Assigned( FList.Items[ i ] ) then
      TObject( FList.Items[ i ] ).Free ;
  FList.Clear ;
end;

//------------------------------------------------------------------------------
constructor TVisList.create;
begin
  inherited create ;
  FList := TList.Create ;
end;

//------------------------------------------------------------------------------
constructor TVisList.CreateExt(const psName: string);
begin
  Create ;
  Name := psName ;
end;

//------------------------------------------------------------------------------
procedure TVisList.Delete(i: integer);
begin
  FList.Delete( i ) ;
end;

//------------------------------------------------------------------------------
destructor TVisList.destroy;
begin
  clear ;
  FList.Free ;
  inherited ;
end;

//------------------------------------------------------------------------------
function TVisList.GetCaption: string;
begin
  result := Name ;
end;

//------------------------------------------------------------------------------
function TVisList.GetCount: integer;
begin
  result := FList.Count ;
end;

//------------------------------------------------------------------------------
function TVisList.GetItems(i:integer): TObject;
begin
  result := FList.Items[i] ;
end;

//------------------------------------------------------------------------------
function TVisList.IndexOf(pData : TObject ) : integer ;
begin
  result := FList.IndexOf( pData ) ;
end;

//------------------------------------------------------------------------------
procedure TVisList.Iterate(pVisitor: TVisitorAbs);
var
  i : integer ;
begin
  inherited iterate( pVisitor ) ;
  for i := 0 to Count - 1 do
    ( TObject( Items[i] ) as TVisitedAbs ).Iterate( pVisitor ) ;
end;

//------------------------------------------------------------------------------
function TVisList.LastItem: TObject;
begin
  result := Items[Count-1] ;
end;

//------------------------------------------------------------------------------
procedure TVisList.SetItems(i: integer; const Value: TObject);
begin
  FList.Items[i] := Value ;
end;

//------------------------------------------------------------------------------
procedure TVisStream.Write(const psValue: string);
var
  lpcValue : PChar ;
begin
  lpcValue := PChar( psValue ) ;
  FStream.WriteBuffer( lpcValue^, length( lpcValue )) ;
end;

//------------------------------------------------------------------------------
procedure TVisStream.WriteLn(const psValue: string);
begin
  Write( psValue + #13 + #10 ) ;
end ;

//------------------------------------------------------------------------------
procedure TVisitorAbs.execute(pVisited: TVisitedAbs);
begin
  Visited := pVisited ;
end;

end.